Developer CD Series 1995…tember: Reference Library/Dev.CD Sep 95 RL/Dev.CD Sep 95 RL.toast/mac/Technical Documentation/develop/develop Issue 23 code/Internet Config/IC 1.1/ICProgKit1.1/Examples/Space Aliens/SpaceAliens.p

Text File | 1995-02-05 | 8.4 KB | 300 lines | [TEXT/PJMM]

program SpaceAliens;
    (* Space Aliens Ate My Icons *)
    (* A drag and drop utility to fix the type and *)
    (* creator of any dropped on file based on its *)
    (* extension and the database of extension mappings *)
    (* provided by Internet Config. *)

    uses
        (* standard system units needed to do AppleEvents *)
        (* remember that Think Pascal automatically uses *)
        (* most of the base operating system *)
        EPPC, AppleEvents,

        (* standard IC units *)
        ICTypes, ICAPI, ICKeys,

        (* bonus IC units, extra libraries shipped *)
        (* as source code *)
        ICMappings, ICSubs;

(* ***** Standard Subroutines ***** *)

    function GotRequiredParams (theAppleEvent: AppleEvent): OSErr;
        (* standard AppleEvent routine copied out of NIM:IAC *)
        var
            typeCode: DescType;
            actualSize: Size;
            err: OSErr;
    begin
        err := AEGetAttributePtr(theAppleEvent,
                            keyMissedKeywordAttr, typeWildCard,
                            typeCode, nil, 0, actualSize);
        if err = errAEDescNotFound then begin
            GotRequiredParams := noErr;
        end
        else if err = noErr then begin
            GotRequiredParams := errAEEventNotHandled;
        end
        else begin
            GotRequiredParams := err;
        end; (* if *)
    end; (* GotRequiredParams *)

(* ***** Global Declarations ***** *)

    const
        my_creator = 'SA8I';
                    (* the application signature *)
    var
        quit_now: boolean;
                    (* set to true when you want main loop to quit *)
        instance: ICInstance;
                    (* global connection to IC *)
        mappings: Handle;
                    (* the mapping preference as returned by IC *)

(* ***** Do The Hard Stuff ***** *)

    function ProcessDocument (fss: FSSpec): OSErr;
        (* this is the core of the program *)
        (* the fss parameter is a file whose extension *)
        (* we'll look up in the IC database *)
        (* mappings global variable is already set up *)
        (* to contain that database *)
        var
            err: OSErr;
            count: longint;
                        (* total number of entries in database *)
            i: longint;
                        (* indexes over the database entries *)
            this: ICMapEntry;
                        (* an unpacked element of the *)
                        (* mappings database, used while stepping *)
                        (* through database *)
            entry: ICMapEntry;
                        (* an mappings database element *)
                        (* used to record the best match *)
            longest_len: integer;
                        (* longest extension we've found so far *)
            posndx: longint;
                        (* the index into the mappings database *)
            info: FInfo;
                        (* temporary for changing type and creator *)
    begin
        (* count the total number of entries *)
        err := ICMapErr(ICMCountEntries(mappings, count));
        if err <> noErr then begin
            count := 0;
        end; (* if *)
        (* loop through the entries *)
        (* looking for the longest match *)
        longest_len := 0;
        posndx := 0;
        for i := 1 to count do begin
            (* ICMGetEntry gets the entry from mappings *)
            (* that starts at posndx *)
            (* and puts it into the entry record *)
            if ICMGetEntry(mappings,
                                        posndx, this) = noErr then begin
                (* increment posndx so that we get the next *)
                (* entry the next time around the loop *)
                posndx := posndx + this.total_length;
                (* the entry matches if *)
                (* not_incoming flag bit is clear *)
                (* it's longer than the previous max *)
                (* it's longer than the file name *)
                (* it matches the last N chars of the filename *)
                if not btst(this.flags,
                                            ICmap_not_incoming_bit)
                        & (length(this.extension) > longest_len)
                        & (length(this.extension) < length(fss.name))
                        & (IUEqualString(copy(fss.name,
                                                                length(fss.name)
                                                                        - length(this.extension)
                                                                        + 1,
                                                                255),
                                                        this.extension) = 0) then begin
                    (* record the new longest entry *)
                    entry := this;
                    longest_len := length(this.extension);
                end; (* if *)
            end; (* if *)
        end; (* for *)

        (* if we found any matches then *)
        (* set the file type and creator appropriately *)
        if longest_len > 0 then begin
            err := HGetFInfo(fss.vRefNum, fss.parID,
                                fss.name, info);
            if err = noErr then begin
                info.fdCreator := entry.file_creator;
                info.fdType := entry.file_type;
                err := HSetFInfo(fss.vRefNum, fss.parID,
                                fss.name, info);
            end; (* if *)
        end
        else begin
            err := noErr;
        end; (* if *)

        quit_now := true;
        ProcessDocument := err;
    end; (* ProcessDocument *)

(* ***** AppleEvent Handlers ***** *)

    function HandleOpenApplication (theAppleEvent: AppleEvent;
                            reply: AppleEvent;
                            refcon: longint): OSErr;
        (* the 'oapp' event handler, displays the about box *)
        (* should most probably only do this if we're in *)
        (* the foreground but that's just too complicated *)
        (* for this example *)
        var
            err: OSErr;
            email_address: Str255;
            junk_attr: longint;
            junk: integer;
            junk_icerr: ICError;
    begin
        err := GotRequiredParams(theAppleEvent);
        if err = noErr then begin
            junk_icerr := ICGetPrefStr(instance, kICEmail,
                                                junk_attr, email_address);
            ParamText(email_address, '', '', '');
            junk := Alert(128, nil);
            quit_now := true;
        end; (* if *)
        HandleOpenApplication := err;
    end; (* HandleOpenApplication *)

    function HandleOpenDocuments (theAppleEvent:AppleEvent;
                            reply: AppleEvent;
                            refcon: longint): OSErr;
        (* a fairly standard 'odoc' event handler *)
        (* gets the document list, counts the items in it *)
        (* gets the FSSpec for each document and calls *)
        (* ProcessDocument on it *)
        var
            fss: FSSpec;
            doc_list: AEDescList;
            index, item_count: longint;
            junk_size: Size;
            junk_keyword: AEKeyword;
            junk_type: descType;
            err, junk: OSErr;
    begin
        err := AEGetParamDesc(theAppleEvent, keyDirectObject,
                            typeAEList, doc_list);
        if err = noErr then begin
            err := GotRequiredParams(theAppleEvent);
            if err = noErr then begin
                err := AECountItems(doc_list, item_count);
            end
            else begin
                item_count := 0;
            end; (* if *)
            for index := 1 to item_count do begin
                if err = noErr then begin
                    err := AEGetNthPtr(doc_list, index, typeFSS,
                                        junk_keyword, junk_type,
                                        @fss, sizeof(fss), junk_size);
                    if err = noErr then begin
                        err := ProcessDocument(fss);
                    end; (* if *)
                end; (* if *)
            end; (* for *)
            junk := AEDisposeDesc(doc_list);
        end; (* if *)
        HandleOpenDocuments := err;
    end; (* HandleOpenDocuments *)

    function HandleQuit (theAppleEvent:AppleEvent;
                            reply: AppleEvent;
                            refcon: longint): OSErr;
        (* a fairly standard 'quit' event handler *)
        (* sets quit_now so that the main event loop quits *)
        var
            err: OSErr;
    begin
        err := GotRequiredParams(theAppleEvent);
        if err = noErr then begin
            quit_now := true;
        end; (* if *)
        HandleQuit := err;
    end; (* HandleQuit *)

    var
        junkbool: boolean;
        event: EventRecord;
        err: OSErr;
        junk: OSErr;
        response: longint;
        attr: longint;
begin
    (* First check for System 7.  OK, so we're supposed *)
    (* to test for functionality but this is example *)
    (* code. *)
    if (Gestalt(gestaltSystemVersion, response) <> noErr)
                | (response < $700) then begin
        ExitToShell;
    end; (* if *)

    (* Now install our AppleEvent handles. *)
    err := AEInstallEventHandler(kCoreEventClass,
                            kAEOpenApplication,
                            @HandleOpenApplication, 0, false);
    if err = noErr then begin
        err := AEInstallEventHandler(kCoreEventClass,
                            kAEOpenDocuments,
                            @HandleOpenDocuments, 0, false);
    end; (* if *)
    if err = noErr then begin
        err := AEInstallEventHandler(kCoreEventClass,
                            kAEQuitApplication,
                            @HandleQuit, 0, false);
    end; (* if *)

    (* startup Internet Config *)
    if err = noErr then begin
        err := ICMapErr(ICStart(instance, my_creator));
        if err = noErr then begin
            err := ICMapErr(ICFindConfigFile(instance, 0, nil));
        end; (* if *)

    (* fetch the mappings preference *)
        if err = noErr then begin
            err := ICMapErr(ICGetPrefHandle(instance, kICMapping,
                                    attr, mappings));
        end; (* if *)

    (* enter main loop *)
        if err = noErr then begin
            quit_now := false;
            while not quit_now do begin
                junkbool := WaitNextEvent(everyEvent, event,
                                                maxlongint, nil);
                case event.what of
                    keyDown:
                        quit_now := true;
                    kHighLevelEvent:
                        junk := AEProcessAppleEvent(event);
                    otherwise
                        ;
                end; (* case *)
            end; (* while *)
        end; (* if *)

        (* shut down IC, only if we successfully started it *)
        junk := ICStop(instance);
    end; (* if *)

    (* beep if we get any errors*)
    (* sophisticated error handling this is not *)
    (* a good place to put a breakpoint this is *)
    if err <> noErr then begin
        SysBeep(10);
    end; (* if *)
end. (* SpaceAliens *)